The London Perl and Raku Workshop takes place on 26th Oct 2024. If your company depends on Perl, please consider sponsoring and/or attending.
Changes 05
MANIFEST 01
META.yml 22
lib/Net/LDAP/Server/Test.pm 3246
t/02-ad.t 066
5 files changed (This is a version diff) 34120
@@ -32,3 +32,8 @@ Revision history for Net-LDAP-Server-Test
         * make debugging messages optional with LDAP_DEBUG env var
         * add support for Net::LDAP::Control (specifically, Net::LDAP::Control::Paged)
 
+0.09    17 Feb 2010
+        * wrap print to $socket handle in {} braces for perl 5.6.x
+        * rewrite _sid2string() and _string2sid() with better pack/unpack magic. Thanks
+          to David Lowe.
+
@@ -5,6 +5,7 @@ MANIFEST
 README
 t/00-load.t
 t/01-ldap.t
+t/02-ad.t
 t/boilerplate.t
 t/pod-coverage.t
 t/pod.t
@@ -1,6 +1,6 @@
 --- #YAML:1.0
 name:               Net-LDAP-Server-Test
-version:            0.08
+version:            0.09
 abstract:           test Net::LDAP code
 author:
     - Peter Karman <karman@cpan.org>
@@ -21,7 +21,7 @@ no_index:
     directory:
         - t
         - inc
-generated_by:       ExtUtils::MakeMaker version 6.50
+generated_by:       ExtUtils::MakeMaker version 6.54
 meta-spec:
     url:      http://module-build.sourceforge.net/META-spec-v1.4.html
     version:  1.4
@@ -7,7 +7,7 @@ use IO::Select;
 use IO::Socket;
 use Data::Dump ();
 
-our $VERSION = '0.08';
+our $VERSION = '0.09';
 
 =head1 NAME
 
@@ -79,7 +79,7 @@ Only one user-level method is implemented: new().
     sub new {
         my ( $class, $sock, %args ) = @_;
         my $self = $class->SUPER::new($sock);
-        printf "Accepted connection from: %s\n", $sock->peerhost();
+        warn sprintf "Accepted connection from: %s\n", $sock->peerhost();
         $self->{_flags} = \%args;
         return $self;
     }
@@ -472,43 +472,45 @@ Only one user-level method is implemented: new().
     }
 
     my $token_counter = 100;
-    my $sid_str       = 'S-01-5-21-350811113-3086823889-3317782326-1234';
+    my $sid_str       = 'S-1-2-3-4-5-6-1234';
+
+    sub _get_server_sid_string { return $sid_str }
+
+    sub _string2sid {
+        my ($string) = @_;
+
+        my ( undef, $revision_level, $authority, @sub_authorities )
+            = split /-/, $string;
+        my $sub_authority_count = scalar @sub_authorities;
+
+        my $sid = pack 'C Vxx C V*', $revision_level, $authority,
+            $sub_authority_count, @sub_authorities;
 
-    sub _sid2string {
-        my $sid = shift;
-        my (@unpack) = unpack( "H2 H2 n N V*", $sid );
-        my ( $sid_rev, $num_auths, $id1, $id2, @ids ) = (@unpack);
-        my $string = join( "-", "S", $sid_rev, ( $id1 << 32 ) + $id2, @ids );
         if ( $ENV{LDAP_DEBUG} ) {
-            carp "sid    = " . Data::Dump::dump($sid);
+            carp "sid    = " . join( '\\', unpack '(H2)*', $sid );
             carp "string = $string";
         }
-        return $string;
+
+        return $sid;
     }
 
-    sub _string2sid {
-        my $string = shift;
-        my (@split) = split( m/\-/, $string );
-        my ( $prefix, $sid_rev, $auth_id, @ids ) = (@split);
-        if ( $auth_id != scalar(@ids) ) {
-            die "bad string: $string";
-        }
+    sub _sid2string {
+        my ($sid) = @_;
 
-        my $sid = pack( "C4", "$sid_rev", "$auth_id", 0, 0 );
-        $sid .= pack( "C4",
-            ( $auth_id & 0xff000000 ) >> 24,
-            ( $auth_id & 0x00ff0000 ) >> 16,
-            ( $auth_id & 0x0000ff00 ) >> 8,
-            $auth_id & 0x000000ff );
+        my ($revision_level,      $authority,
+            $sub_authority_count, @sub_authorities
+        ) = unpack 'C Vxx C V*', $sid;
+
+        die if $sub_authority_count != scalar @sub_authorities;
+
+        my $string = join '-', 'S', $revision_level, $authority,
+            @sub_authorities;
 
-        for my $i (@ids) {
-            $sid .= pack( "I", $i );
-        }
         if ( $ENV{LDAP_DEBUG} ) {
-            carp "sid    = " . Data::Dump::dump($sid);
+            carp "sid    = " . join( '\\', unpack '(H2)*', $sid );
             carp "string = $string";
         }
-        return $sid;
+        return $string;
     }
 
     sub _add_AD {
@@ -520,8 +522,11 @@ Only one user-level method is implemented: new().
 
                     # groups
                     $token_counter++;
-                    ( my $group_sid_str = $sid_str )
+                    ( my $group_sid_str = _get_server_sid_string() )
                         =~ s/-1234$/-$token_counter/;
+                    if ( $ENV{LDAP_DEBUG} ) {
+                        carp "group_sid_str = $group_sid_str";
+                    }
                     $entry->add( 'primaryGroupToken' => $token_counter );
                     $entry->add( 'objectSID'         => "$group_sid_str" );
                     $entry->add( 'distinguishedName' => $key );
@@ -531,8 +536,17 @@ Only one user-level method is implemented: new().
 
                     # users
                     my $gid = $entry->get_value('primaryGroupID');
-                    ( my $user_sid_str = $sid_str ) =~ s/-1234$/-$gid/;
+                    ( my $user_sid_str = _get_server_sid_string() )
+                        =~ s/-1234$/-$gid/;
+
                     my $user_sid = _string2sid($user_sid_str);
+
+                    if ( $ENV{LDAP_DEBUG} ) {
+                        carp "user_sid        = "
+                            . join( '\\', unpack '(H2)*', $user_sid );
+                        carp "user_sid_string = $user_sid_str";
+                    }
+
                     $entry->add( 'objectSID'         => $user_sid );
                     $entry->add( 'distinguishedName' => $key );
 
@@ -709,7 +723,7 @@ Only one user-level method is implemented: new().
                     }
                     my $pdu = $LDAPResponse->encode($response);
                     if ($pdu) {
-                        print $socket $pdu;
+                        print {$socket} $pdu;
                     }
                     else {
                         $result = undef;
@@ -734,7 +748,7 @@ Only one user-level method is implemented: new().
         }
 
         # and now send the result to the client
-        print $socket _encode_result( $mid, $respType, $result, $controls );
+        print {$socket} _encode_result( $mid, $respType, $result, $controls );
 
         return 0;
     }
@@ -0,0 +1,66 @@
+use Test::More tests => 9;
+
+use strict;
+use warnings;
+use Carp;
+
+use Net::LDAP;
+use Net::LDAP::Server::Test;
+use Net::LDAP::Entry;
+
+#
+# these tests pulled nearly verbatim from the Net::LDAP synopsis
+#
+
+my %opts = (
+    port  => '10636',
+    dnc   => 'ou=internal,dc=foo',
+    debug => $ENV{PERL_DEBUG} || 0,
+
+);
+
+my $host = 'ldap://localhost:' . $opts{port};
+
+#
+#   TODO front-load real AD data with schema.
+#
+#
+ok( my $server
+        = Net::LDAP::Server::Test->new( $opts{port}, active_directory => 1, ),
+    "spawn new server"
+);
+
+ok( my $ldap = Net::LDAP->new( $host, %opts, ), "new LDAP connection" );
+
+unless ($ldap) {
+    croak "Unable to connect to LDAP server $host: $@";
+}
+
+ok( my $rc = $ldap->bind(), "LDAP bind()" );
+
+ok( my $mesg = $ldap->search(    # perform a search
+        base   => "c=US",
+        filter => "(&(sn=Barr) (o=Texas Instruments))"
+    ),
+    "LDAP search()"
+);
+
+$mesg->code && croak $mesg->error;
+
+my $count = 0;
+foreach my $entry ( $mesg->entries ) {
+
+    #$entry->dump;
+    $count++;
+}
+
+is( $count, 13, "$count entries found in search" );
+
+# test our SID utility functions
+ok( my $server_sid_string = MyLDAPServer::_get_server_sid_string(),
+    "get server sid" );
+ok( my $sid = MyLDAPServer::_string2sid($server_sid_string), "string2sid" );
+is( $server_sid_string, MyLDAPServer::_sid2string($sid), "sid2string" );
+
+# quit
+ok( $mesg = $ldap->unbind, "LDAP unbind()" );